home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / simcode.arc / LOGIN.PAS < prev    next >
Pascal/Delphi Source File  |  1985-01-19  |  13KB  |  495 lines
  1. {$symtab-,$linesize:131,$pagesize:86,$debug-,
  2. $title:'LOGIN.PAS -- Script Interpreter'}
  3. {       COPYRIGHT @ 1982
  4.     Jim Holtman and Eric Holtman
  5.     35 Dogwood Trail
  6.     Randolph, NJ 07869
  7.     (201) 361-3395
  8. }
  9.  
  10.  module script;
  11.  
  12.      type
  13.      menu_c = super array[1..*] of lstring(40);
  14.      instruction = record
  15.          state, action, yes, no : integer;
  16.          act_str : lstring(40);
  17.          end;
  18.  
  19.      var
  20.      strs : array[1..20] of array[1..20] of ^lstring;
  21.      max_sys : integer;
  22.      menu : menu_c(20);
  23.      cancel_command [external] : boolean;
  24.      inst : array[1..200] of ^instruction;
  25.      been_read_yet : boolean;
  26.      stack : array[1..20] of integer;
  27.      stack_ptr : integer;
  28.      time_out_value : word;
  29.      log_file [external] : file of char;
  30.      log_flag [external] : boolean;
  31.      script_verbose [external] : boolean;
  32.      value been_read_yet := false;
  33.      stack_ptr := 0;
  34.      time_out_value := 15;       {$include:'token.h'}
  35.                    {$include:'graph.inc'}
  36.                    {$include:'comm.inc'}
  37.                    {$include:'simterm.inc'}
  38.                    {$include:'util.inc'}
  39.  
  40.      procedure parse_file(var s : lstring);
  41.  
  42.      external;
  43.  
  44.      procedure push_label(i : integer);
  45.  
  46.      begin
  47.          stack_ptr := stack_ptr + 1;
  48.          stack[stack_ptr] := i;
  49.          end;
  50.  
  51.      function pop_label : integer;
  52.  
  53.      begin
  54.          if (stack_ptr > 0) then begin
  55.          pop_label := stack[stack_ptr];
  56.          stack_ptr := stack_ptr - 1;
  57.          end
  58.          else pop_label := -1;
  59.          end;
  60.  
  61.      function menuit(var choices : menu_c;
  62.        const title : lstring ) : integer;
  63.  
  64.      external;
  65.  
  66.      procedure dial(var s:lstring);
  67.  
  68.      external;
  69.  
  70.      function getc(exit_flag : LOOP_FLAG) : integer;
  71.  
  72.      external;
  73.  
  74.      procedure putchar(ch : char);
  75.  
  76.      external;
  77.  
  78.      procedure ck(a : integer;
  79.        const b : string);
  80.  
  81.      external;
  82.  
  83.      procedure savescreen;
  84.  
  85.      external;
  86.  
  87.      procedure restorescreen;
  88.  
  89.      external;
  90.  
  91.      function do_cancel : boolean;
  92.  
  93.      external;
  94.  
  95.      function find_state(st : integer) : integer;
  96.  
  97.      var
  98.          i : integer;
  99.  
  100.      begin
  101.          for i := 1 to max_sys do BEGIN
  102.          if (inst[i]^.state = st) then begin
  103.              find_state := i;
  104.              return;
  105.              end   END;
  106.          find_state := -1;
  107.          end;
  108.  
  109.      function find_label(const st : lstring) : integer;
  110.  
  111.      var
  112.          i : integer;
  113.  
  114.      begin
  115.          for i := 1 to max_sys do BEGIN
  116.          if ((inst[i]^.action = A_LABEL) and (st = inst[i]^.act_str)) then begin
  117.              find_label := i;
  118.              return;
  119.              end   END;
  120.          find_label := -1;
  121.          end;
  122.  
  123.      function expect(const str : lstring) : boolean;
  124.  
  125.      var
  126.          i : integer;
  127.          t : word;
  128.          inch : char;
  129.          ch : integer;
  130.          back : char;
  131.          time_out : boolean;
  132.  
  133.      begin
  134.          cancel_command := false;
  135.          t := timer;
  136.          time_out := false;
  137.          while (time_out = false) do begin
  138.          i := 1;
  139.          while (i <= ord(str.len)) or (str.len = 0) do begin
  140.              t := timer;
  141.              while (timer - t < time_out_value) do begin
  142.              if do_cancel then return;
  143.              ch := getc(EXIT);
  144.              if (ch > -1) then break;
  145.              end;
  146.              if log_flag and (ch > -1) then begin
  147.              log_file^ := chr(ch);
  148.              put(log_file);
  149.              end;
  150.              if (ch > -1) then putchar(chr(ch));
  151.              if (timer - t >= time_out_value) then begin
  152.              time_out := true;
  153.              break;
  154.              end;
  155.              if (str.len > 0) then BEGIN
  156.              if (ch <> ord(str[i])) then begin
  157.                  if (ch = ord(str[1])) then i := 2
  158.                  else i := 1;
  159.                  cycle;
  160.                  end   END;
  161.              i := i + 1;
  162.              end;
  163.          if (i = ord(str.len)+1) and (str.len <> 0) then begin
  164.              expect := true;
  165.              return;
  166.              end;
  167.          end;
  168.          expect := false;
  169.          end;
  170.  
  171.      function look_for(var strs : menu_c) : integer;
  172.  
  173.      var
  174.          i : integer;
  175.          t : word;
  176.          inch : char;
  177.          ch : integer;
  178.          back : char;
  179.          time_out : boolean;
  180.          cnt : integer;
  181.          ptr : array[1..20] of integer;
  182.          num_strs : integer;
  183.  
  184.      begin
  185.          cancel_command := false;
  186.          t := timer;
  187.          time_out := false;
  188.          num_strs := 0;
  189.          for cnt := 1 to 20 do begin
  190.          ptr[cnt] := 0;
  191.          if (strs[cnt].len > 0) then num_strs := num_strs + 1;
  192.          end;
  193.          while (time_out = false) do begin
  194.          for cnt := 1 to num_strs do begin
  195.              if (strs[cnt].len > 0) and (strs[cnt].len <= wrd(ptr[cnt])) then begin
  196.              look_for := cnt;
  197.              return;
  198.              end;
  199.              ptr[cnt] := ptr[cnt] + 1;
  200.              end;
  201.          t := timer;
  202.          while (timer - t < time_out_value) do begin
  203.              if do_cancel then begin
  204.              look_for := 0;
  205.              return;
  206.              end;
  207.              ch := getc(EXIT);
  208.              if (ch > -1) then break;
  209.              end;
  210.          if log_flag and (ch > -1) then begin
  211.              log_file^ := chr(ch);
  212.              put(log_file);
  213.              end;
  214.          if (ch > -1) then putchar(chr(ch));
  215.          if (timer - t >= time_out_value) then begin
  216.              time_out := true;
  217.              break;
  218.              end;
  219.          for cnt := 1 to num_strs do begin
  220.              if (ch <> ord(strs[cnt,ptr[cnt]])) then begin
  221.              if (ch = ord(strs[cnt,1])) then ptr[cnt] := 1
  222.              else ptr[cnt] := 0;
  223.              end;
  224.              end;
  225.          end;
  226.          look_for := 0;
  227.          end;
  228.  
  229.      procedure send_parse(const s : lstring);
  230.  
  231.      var
  232.          i : integer;
  233.          sum : word;
  234.          char_send : char;
  235.  
  236.      const
  237.          BACKSL = '\';
  238.          CR = chr(13);
  239.          LF = chr(10);
  240.  
  241.      begin
  242.          i := 1;
  243.          while (i <= ord(s.len)) do begin
  244.          if (s[i] = '\') then begin
  245.              case s[i+1] of
  246.              
  247.              '\': begin
  248.                  send(BACKSL);
  249.                  i := i + 1;
  250.                  end;
  251.              
  252.              'B': begin
  253.                      eval(breaker);
  254.                  i := i+1;
  255.                  end;
  256.                  
  257.              'm': begin
  258.                  send(CR);
  259.                  i := i + 1;
  260.                  end;
  261.              
  262.              'j': begin
  263.                  send(LF);
  264.                  i := i + 1;
  265.                  end;
  266.  
  267.              '1': begin
  268.                  sleep(1);
  269.                  i := i + 1;
  270.                  end;
  271.              'c': return;
  272.  
  273.              'o': begin
  274.                  sum := 0;
  275.                  for i:=i+2 to ord(s.len) do
  276.                     if s[i] in ['0'..'7'] then
  277.                        sum := sum*8+wrd(s[i])-wrd('0')
  278.                     else break;
  279.                  i := i-1;
  280.                 char_send := chr(sum and #FF);
  281.                  send(char_send);
  282.                  end;
  283.                  
  284.              otherwise ;
  285.              end;
  286.              end
  287.          else send(s[i]);
  288.          i := i + 1;
  289.          end;
  290.          send(CR);
  291.          end;
  292.  
  293.      function conn(i : integer) : integer;
  294.  
  295.      var
  296.          l : integer;
  297.          num : lstring(40);
  298.          j : integer;
  299.          strs : menu_c(20);
  300.          lf : integer;
  301.  
  302.      const
  303.          cr = chr(13);
  304.  
  305.      begin               {riteln('parsing
  306.                       ',i,inst[i]^.state,inst[i]^.action,inst[i]^.yes,inst[i]^.no,inst[i]^.act_str);}
  307.          if do_cancel then return;
  308.          if (inst[i]^.yes < 0) then begin
  309.          sleep(4);
  310.          restorescreen;
  311.          conn := -1;
  312.          return;
  313.          end;
  314.          if (inst[i]^.action = A_TOGGLE_TR) then begin
  315.          toggle_tr;
  316.          if (script_verbose) then writeln('Hanging up phone');
  317.          end
  318.          else if (inst[i]^.action = A_OPENLOG) then begin
  319.          copylst(inst[i]^.act_str, num);
  320.          parse_file(num);
  321.          assign(log_file,num);
  322.          rewrite(log_file);
  323.          log_flag := true;
  324.          if (script_verbose) then writeln('Opening ',num,' for logging');
  325.          end
  326.          else if (inst[i]^.action = A_CLOSELOG) then begin
  327.          if (log_flag) then begin
  328.              if (script_verbose) then writeln('Closing LOGFILE');
  329.              close(log_file);
  330.              log_flag := false;
  331.              end
  332.          else if (script_verbose) then writeln( 'Error: no LOGFILE to close, INST = ',i);
  333.          end
  334.          else if (inst[i]^.action = A_DIAL) then begin
  335.          copylst(inst[i]^.act_str, num);
  336.          dial(num);
  337.          end
  338.          else if (inst[i]^.action = A_SETTIME) then begin
  339.          if (script_verbose) then writeln('Set time-out to ',inst[i]^. act_str);
  340.          if (decode(inst[i]^.act_str, time_out_value) = false) then begin
  341.              if (script_verbose) then writeln('Illegal settime value; ',inst[ i]^.act_str);
  342.              time_out_value := 15;
  343.              end;
  344.          end
  345.          else if (inst[i]^.action = A_CASE) then begin
  346.          if (script_verbose) then write('Case: ');
  347.          for l := 1 to 20 do begin
  348.              if (inst[find_state(inst[i]^.yes+l-1)]^.action = TOK_CASEEND) then begin
  349.              strs[l].len := 0;
  350.              lf := look_for(strs);
  351.              if (script_verbose) then begin
  352.                  writeln;
  353.                  if (lf > 0) then writeln('Got ',strs[lf])
  354.                  else writeln('got OTHERWISE');
  355.                  end;
  356.              conn := find_state(inst[find_state(inst[i]^.yes+lf-1)]^.yes);
  357.              return;
  358.              end;
  359.              copylst(inst[find_state(inst[i]^.yes+l-1)]^.act_str,strs[l]);
  360.              if (script_verbose) then write('"',strs[l],'" ');
  361.              end;
  362.          end
  363.          else if (inst[i]^.action = A_INPUT) then begin
  364.          write(inst[i]^.act_str);
  365.          readln(num);
  366.          send_parse(num);
  367.          end
  368.          else if (inst[i]^.action = A_EXPECT) then begin
  369.          if (inst[i]^.act_str.len > 0) then begin
  370.              if (script_verbose) then writeln('Looking for "',inst[i]^. act_str,'"')   end
  371.          else writeln('Looking for nothing in particular, just a time-out');
  372.          if (expect(inst[i]^.act_str) = false) then begin
  373.              if (script_verbose) then writeln('Failed. Could not receive "', inst[i]^.act_str,'"');
  374.              sleep(2);
  375.              conn := find_state(inst[i]^.no);
  376.              return;
  377.              end;
  378.          if (script_verbose) then writeln('Got it');
  379.          end
  380.          else if (inst[i]^.action = A_SEND) then begin
  381.          if (script_verbose) then writeln('Sending "',inst[i]^.act_str,'"');
  382.          send_parse(inst[i]^.act_str);
  383.          end
  384.          else if (inst[i]^.action = A_SAY) then begin
  385.          writeln(inst[i]^.act_str);
  386.          end
  387.          else if (inst[i]^.action = A_LABEL) then begin
  388.                    { NO - OP }
  389.          end
  390.          else if (inst[i]^.action = A_NGOTO) then begin
  391.                    { NO - OP }
  392.          end
  393.          else if (inst[i]^.action = A_LGOTO) then begin
  394.          if (script_verbose) then writeln('Goto "',inst[i]^.act_str,'"');
  395.          conn := find_label(inst[i]^.act_str);
  396.          return;
  397.          end
  398.          else if (inst[i]^.action = A_GOSUB) then begin
  399.          if (script_verbose) then writeln('Gosub "',inst[i]^.act_str,'"');
  400.          push_label(inst[i]^.state + 1);
  401.          conn := find_label(inst[i]^.act_str);
  402.          return;
  403.          end
  404.          else if (inst[i]^.action = A_RETURN) then begin
  405.          if (script_verbose) then writeln('Return');
  406.          l := pop_label;
  407.          if (l < 0) then begin
  408.              writeln('Return without gosub, instruction number ',inst[i]^. state);
  409.              return;
  410.              end
  411.          else conn := find_state(l);
  412.          return;
  413.          end;
  414.          conn := find_state(inst[i]^.yes);
  415.          return;
  416.          end;
  417.  
  418.      procedure compile(var s : lstring);
  419.  
  420.      external;
  421.  
  422.      procedure login [public];
  423.  
  424.      var
  425.          i,j,l : integer;
  426.          k : byte;
  427.          sfile : text;
  428.          buf : lstring(128);
  429.          cbuf : lstring(128);
  430.          key : lstring(8);
  431.          ch : char;
  432.          script_file [external] : lstring(20);
  433.          first_script [external] : lstring(20);
  434.          cryptic : boolean;
  435.  
  436.      begin
  437.          cancel_command := false;
  438.          savescreen;
  439.          if (not been_read_yet) then begin
  440.          been_read_yet := true;
  441.          assign(sfile, script_file);
  442.          reset(sfile);
  443.          readln(sfile, buf);
  444.          if (buf <> '#compiled') then begin
  445.              close(sfile);
  446.              compile(script_file);
  447.              assign(sfile, script_file);
  448.              reset(sfile);
  449.              readln(sfile, buf);
  450.              end;
  451.          max_sys := 0;
  452.          while not eof(sfile) do begin
  453.              max_sys := max_sys + 1;
  454.              new(inst[max_sys]);
  455.              readln(sfile, inst[max_sys]^.state, inst[max_sys]^.action, inst[ max_sys]^.yes, inst[max_sys]^.no,
  456.                inst[ max_sys]^.act_str);
  457.              delete(inst[max_sys]^.act_str,1,1);
  458.              end;
  459.          end;
  460.          if (first_script.len = 0) then begin
  461.          j := 0;
  462.          for i := 1 to max_sys do begin
  463.              if (inst[i]^.action = A_ENTRY) then begin
  464.              j := j + 1;
  465.              copylst(inst[i]^.act_str, menu[j]);
  466.              end;
  467.              end;
  468.          menu[j+1].len := 0;
  469.          i := menuit(menu, 'Scripts available');
  470.          if (i > 0) then begin
  471.                    {writeln('Executing script ',menu[i]);}
  472.              for j := 1 to max_sys do begin
  473.              if ((menu[i] = inst[j]^.act_str) and (inst[j]^.action = A_ENTRY)) then break;
  474.              end;
  475.              i := j;
  476.              end;
  477.          end
  478.          else BEGIN
  479.          for i := 1 to max_sys do BEGIN
  480.              if ((first_script = inst[i]^.act_str) and (inst[i]^.action = A_ENTRY)) then break     END   END;
  481.  
  482.          if ((i = 0) or (i=max_sys+1) ) then begin
  483.          restorescreen;
  484.          return;
  485.          end;
  486.          restorescreen;
  487.          i := find_state(inst[i]^.yes);
  488.          while (i >= 0) do i := conn(i);
  489.          end;
  490.  
  491.      procedure alogin [public];
  492.  
  493.      begin
  494.          end;   end.
  495.